home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / mint / editors / mntemacs.zoo / src / lread.c < prev    next >
C/C++ Source or Header  |  1991-12-02  |  32KB  |  1,315 lines
  1. /* Lisp parsing and input streams.
  2.    Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include <stdio.h>
  22. #include <sys/types.h>
  23. #include <sys/stat.h>
  24. #include <sys/file.h>
  25. #undef NULL
  26. #include "config.h"
  27. #include "lisp.h"
  28.  
  29. /**
  30.  **  (sjk)++ a simple prototype. :-)
  31.  **/
  32. #ifdef atarist
  33. static int read_escape();
  34. #endif
  35.  
  36. #ifndef standalone
  37. #include "buffer.h"
  38. #include "paths.h"
  39. #endif
  40.  
  41. #ifdef lint
  42. #include <sys/inode.h>
  43. #endif /* lint */
  44.  
  45. #ifndef X_OK
  46. #define X_OK 01
  47. #endif
  48.  
  49. Lisp_Object Qread_char, Qget_file_char, Qstandard_input;
  50. Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input;
  51.  
  52. /* non-zero if inside `load' */
  53. int load_in_progress;
  54.  
  55. /* Search path for files to be loaded. */
  56. Lisp_Object Vload_path;
  57.  
  58. /* File for get_file_char to read from.  Use by load */
  59. static FILE *instream;
  60.  
  61. /* When nonzero, read conses in pure space */
  62. static int read_pure;
  63.  
  64. /* For use within read-from-string (this reader is non-reentrant!!) */
  65. static int read_from_string_index;
  66. static int read_from_string_limit;
  67.  
  68. /* Handle unreading and rereading of characters.
  69.  Write READCHAR to read a character, UNREAD(c) to unread c to be read again. */
  70.  
  71. static int unrch;
  72.  
  73. static int readchar (readcharfun)
  74.      Lisp_Object readcharfun;
  75. {
  76.   Lisp_Object tem;
  77.   register struct buffer *inbuffer;
  78.   register int c, mpos;
  79.  
  80.   if (unrch >= 0)
  81.     {
  82.       c = unrch;
  83.       unrch = -1;
  84.       return c;
  85.     }
  86.   if (XTYPE (readcharfun) == Lisp_Buffer)
  87.     {
  88.       inbuffer = XBUFFER (readcharfun);
  89.  
  90.       if (BUF_PT (inbuffer) >= BUF_ZV (inbuffer))
  91.     return -1;
  92.       c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, BUF_PT (inbuffer));
  93.       SET_BUF_PT (inbuffer, BUF_PT (inbuffer) + 1);
  94.       return c;
  95.     }
  96.   if (XTYPE (readcharfun) == Lisp_Marker)
  97.     {
  98.       inbuffer = XMARKER (readcharfun)->buffer;
  99.       mpos = marker_position (readcharfun);
  100.  
  101.       if (mpos > BUF_ZV (inbuffer) - 1)
  102.     return -1;
  103.       c = *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer, mpos);
  104.       if (mpos != BUF_GPT (inbuffer))
  105.     XMARKER (readcharfun)->bufpos++;
  106.       else
  107.     Fset_marker (readcharfun, make_number (mpos + 1),
  108.              Fmarker_buffer (readcharfun));
  109.       return c;
  110.     }
  111.   if (EQ (readcharfun, Qget_file_char))
  112.     return getc (instream);
  113.  
  114.   if (XTYPE (readcharfun) == Lisp_String)
  115.     {
  116.       register int c;
  117.       /* This used to be return of a conditional expression,
  118.      but that truncated -1 to a char on VMS.  */
  119.       if (read_from_string_index < read_from_string_limit)
  120.     c = XSTRING (readcharfun)->data[read_from_string_index++];
  121.       else
  122.     c = -1;
  123.       return c;
  124.     }
  125.  
  126.   tem = call0 (readcharfun);
  127.  
  128.   if (NULL (tem))
  129.     return -1;
  130.   return XINT (tem);
  131. }
  132.  
  133. #define READCHAR readchar(readcharfun)
  134. #define UNREAD(c) (unrch = c)
  135.  
  136. static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
  137.  
  138. /* get a character from the tty */
  139.  
  140. DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0,
  141.   "Read a character from the command input (keyboard or macro).\n\
  142. It is returned as a number.")
  143.   ()
  144. {
  145.   register Lisp_Object val;
  146.  
  147. #ifndef standalone
  148.   XSET (val, Lisp_Int, read_command_char (0));
  149. #else
  150.   XSET (val, Lisp_Int, getchar ());
  151. #endif
  152.  
  153.   return val;
  154. }
  155.  
  156. DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
  157.   "Don't use this yourself.")
  158.   ()
  159. {
  160.   register Lisp_Object val;
  161.   XSET (val, Lisp_Int, getc (instream));
  162.   return val;
  163. }
  164.  
  165. void readevalloop ();
  166. static Lisp_Object load_unwind ();
  167.  
  168. DEFUN ("load", Fload, Sload, 1, 4, 0,
  169.   "Execute a file of Lisp code named FILE.\n\
  170. First tries FILE with .elc appended, then tries with .el,\n\
  171.  then tries FILE unmodified.  Searches directories in  load-path.\n\
  172. If optional second arg NOERROR is non-nil,\n\
  173.  report no error if FILE doesn't exist.\n\
  174. Print messages at start and end of loading unless\n\
  175.  optional third arg NOMESSAGE is non-nil.\n\
  176. If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
  177.  suffixes .elc or .el to the specified name FILE.\n\
  178. Return t if file exists.")
  179.   (str, noerror, nomessage, nosuffix)
  180.      Lisp_Object str, noerror, nomessage, nosuffix;
  181. {
  182.   register FILE *stream;
  183.   register int fd = -1;
  184.   register Lisp_Object lispstream;
  185.   register FILE **ptr;
  186.   int count = specpdl_ptr - specpdl;
  187.   struct gcpro gcpro1;
  188.  
  189.   CHECK_STRING (str, 0);
  190.   str = Fsubstitute_in_file_name (str);
  191.  
  192.   /* Avoid weird lossage with null string as arg,
  193.      since it would try to load a directory as a Lisp file */
  194.   if (XSTRING (str)->size > 0)
  195.     {
  196.       fd = openp (Vload_path, str, !NULL (nosuffix) ? "" : ".elc:.el:", 0, 0);
  197.     }
  198.  
  199.   if (fd < 0)
  200.     if (NULL (noerror))
  201.       while (1)
  202.     Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
  203.                      Fcons (str, Qnil)));
  204.     else return Qnil;
  205.  
  206.   stream = fdopen (fd, "r");
  207.   if (stream == 0)
  208.     {
  209.       close (fd);
  210.       error ("Failure to create stdio stream for %s", XSTRING (str)->data);
  211.     }
  212.  
  213.   if (NULL (nomessage))
  214.     message ("Loading %s...", XSTRING (str)->data);
  215.  
  216.   GCPRO1 (str);
  217.   ptr = (FILE **) xmalloc (sizeof (FILE *));
  218.   *ptr = stream;
  219.   XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
  220.   record_unwind_protect (load_unwind, lispstream);
  221.   load_in_progress++;
  222.   readevalloop (Qget_file_char, stream, Feval, 0);
  223.   unbind_to (count);
  224.   UNGCPRO;
  225.  
  226.   if (!noninteractive && NULL (nomessage))
  227.     message ("Loading %s...done", XSTRING (str)->data);
  228.   return Qt;
  229. }
  230.  
  231. static Lisp_Object
  232. load_unwind (stream)  /* used as unwind-protect function in load */
  233.      Lisp_Object stream;
  234. {
  235.   fclose (*(FILE **) XSTRING (stream));
  236.   free (XPNTR (stream));
  237.   if (--load_in_progress < 0) load_in_progress = 0;
  238.   return Qnil;
  239. }
  240.  
  241.  
  242. static int
  243. absolute_filename_p (pathname)
  244.      Lisp_Object pathname;
  245. {
  246.   register unsigned char *s = XSTRING (pathname)->data;
  247.   return (*s == '~' || *s == '/'
  248. /**
  249.  **  (sjk)++ added || defined(atarist) below
  250.  **/
  251. #if defined(VMS) || defined(atarist)
  252.       || index (s, ':')
  253. #endif /* VMS or atarist */
  254.       );
  255. }
  256.  
  257. /* Search for a file whose name is STR, looking in directories
  258.    in the Lisp list PATH, and trying suffixes from SUFFIX.
  259.    SUFFIX is a string containing possible suffixes separated by colons.
  260.    On success, returns a file descriptor.  On failure, returns -1.
  261.  
  262.    EXEC_ONLY nonzero means don't open the files,
  263.    just look for one that is executable.  In this case,
  264.    returns 1 on success.
  265.  
  266.    If STOREPTR is nonzero, it points to a slot where the name of
  267.    the file actually found should be stored as a Lisp string.
  268.    Nil is stored there on failure.  */
  269.  
  270. int
  271. openp (path, str, suffix, storeptr, exec_only)
  272.      Lisp_Object path, str;
  273.      char *suffix;
  274.      Lisp_Object *storeptr;
  275.      int exec_only;
  276. {
  277.   register int fd;
  278.   int fn_size = 100;
  279.   char buf[100];
  280.   register char *fn = buf;
  281.   int absolute = 0;
  282.   int want_size;
  283.   register Lisp_Object filename;
  284.   struct stat st;
  285.  
  286.   if (storeptr)
  287.     *storeptr = Qnil;
  288.  
  289.   if (absolute_filename_p (str))
  290.     absolute = 1;
  291.  
  292.   for (; !NULL (path); path = Fcdr (path))
  293.     {
  294.       char *nsuffix;
  295.  
  296.       filename = Fexpand_file_name (str, Fcar (path));
  297.       if (!absolute_filename_p (filename))
  298.     /* If there are non-absolute elts in PATH (eg ".") */
  299.     /* Of course, this could conceivably lose if luser sets
  300.        default-directory to be something non-absolute... */
  301.     {
  302.       filename = Fexpand_file_name (filename, current_buffer->directory);
  303.       if (!absolute_filename_p (filename))
  304.         /* Give up on this path element! */
  305.         continue;
  306.     }
  307.  
  308.       /* Calculate maximum size of any filename made from
  309.      this path element/specified file name and any possible suffix.  */
  310.       want_size =